Games of Daze/Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso/x2ftp/msdos/source/demostu2/shade1.pas

Pascal/Delphi Source File | 1994-12-13 | 8.4 KB | 494 lines

program Read1;
{
  Vector shade
  - by Bjarke Viksφe
  aug 1994

  Works pretty much the same as gouraud vectors.
  Instead of using z-coord as colour, we use a fixed colour value
  to shade to.
}

{$DEFINE DEBUG}

uses
    DEMOINIT;

const
    NUMBER_FACES = 6;
    NUMBER_COORDS = 8;
    box = 120; {size of box}

type
    SlopeType = array[0..200*2] of integer;

    FaceType = RECORD
        l1,l2,l3,l4 : byte;
    end;


var
    slope,zslope : SlopeType;
    face : array[1..NUMBER_FACES] of FaceType;
    cbuffer : array[0..NUMBER_COORDS*4-1] of integer;

    LineTable1 : array[0..319] of byte;
    LineTable2 : array[0..319] of byte;

    miny,maxy, scrminy,scrmaxy : integer;
    lastscrminy,lastscrmaxy : integer;

    sinustabel : array[0..639] of integer;
    v1,v2,v3 : word;
    cos1,sin1,cos2,sin2,cos3,sin3 : integer;

    xkoord,ykoord,zkoord, n : integer;

const
    {setup coords for a box}
    coords : array[0..NUMBER_COORDS*3-1] of integer =
        (box,box,-box, -box,box,-box, -box,-box,-box, box,-box,-box,
        box,box,box, -box,box,box, -box,-box,box, box,-box,box);

const
    display1 : word = $0000;
    display2 : word = $4000;


(*------------------------------------------------*)

procedure SetupSinus;
var
    i : integer;
    v, vadd : real;
begin
    v:=0.0;
    vadd:=(2.0*pi/512.0);
    for i:=0 to 639 do begin
        sinustabel[i]:=round(sin(v)*32767);
        v:=v+vadd;
    end;
end;

procedure SetupFaces;
{setup faces. Make sure face keeps track of which coordinates it uses!}
begin
    with face[1] do begin l1:=3; l2:=2; l3:=1; l4:=0; end;
    with face[2] do begin l1:=4; l2:=5; l3:=6; l4:=7; end;
    with face[3] do begin l1:=0; l2:=1; l3:=5; l4:=4; end;
    with face[4] do begin l1:=1; l2:=2; l3:=6; l4:=5; end;
    with face[5] do begin l1:=2; l2:=3; l3:=7; l4:=6; end;
    with face[6] do begin l1:=3; l2:=0; l3:=4; l4:=7; end;
end;

procedure InitDemo;
var
    i : integer;
begin
    Screen_Off;
    ClearWholeScreen;
    SetupSinus;
    SetupFaces;

    scrminy := 0; scrmaxy := 200;
    lastscrminy := 0; lastscrmaxy := 200;
    v1:=0; v2:=0; v3:=0;

    for i:=1 to 63 do SetRGB(i,0,64-i,40);
    for i:=64 to 127 do SetRGB(i,0,0,0);

    for i:=0 to 319 do begin
        LineTable1[i]:=(15 SHL (i AND 3)) AND 15;
        LineTable2[i]:=(2 SHL (i AND 3))-1;
    end;

    Screen_On;
end;


(*------------------------------------------------*)

procedure SwapDisplay;
var
    temp : word;
begin
    temp:=display2;
    display2:=display1;
    display1:=temp;
    SetAddress(Ptr(SEGA000,display2));
end;

procedure ClearScreen(y1,y2 : integer); assembler;
asm
    mov    dx,$3C4
    mov    ax,$0F02
    out    dx,ax

    mov    bx,y1        {clear box around vector - only y-coords are actually}
    mov    dx,y2        {used for calculation... x-coords are constant 192 pixels}
    sub    dx,bx
    cmp    dx,200
    ja        @done

    lea    si,ytabel
    add    bx,bx
    mov    di,[si+bx]
    add    di,display1
    add    di,16

    mov    es,SEGA000
    xor ax,ax
    mov    bx,48/2
@loop:
    mov    cx,bx
    rep stosw
    add    di,WIDTH-48
    dec    dl
    jnz    @loop
@done:
end;


(*------------------------------------------------*)

procedure ClearSlope; assembler;
asm
    mov    ax,ds
    mov    es,ax
    lea    di,slope
    DB LONG; mov ax,$8000; DW $8000;
    cld
    mov    cx,TYPE(slopetype)/4
    rep; DB LONG; stosw
end;

procedure CalcSlope(l1,l2 : integer; col1a,col1b : word); assembler;
var
    col1add : word;
    xlowadd : word;
    ysize : integer;
asm
    lea    si,cbuffer
    DB LONG; xor cx,cx
    mov    bx,l1                    {get first coords}
    shl    bx,3
    mov    dx,[si+bx]            {get x/y coords}
    mov    cx,[si+bx+2]

    mov    ax,l2                    {get second coords}
    shl    ax,3
    add    si,ax
    mov    ax,[si]                {get x/y coords}
    mov    bx,[si+2]

    cmp    bx,cx                    {make sure we go downwards...}
    jle    @noswap
    mov    si,col1a                {swap colour}
    xchg    col1b,si
    mov    col1a,si
    xchg    ax,dx                    {swap x}
    xchg    bx,cx                    {sway y}
@noswap:

    cmp    bx,miny                {record miny and maxy}
    jae    @miny
    mov    miny,bx
@miny:
    cmp    cx,maxy
    jbe    @maxy
    mov    maxy,cx
@maxy:

    sub    cx,bx
    jcxz    @zero
    mov    ysize,cx
    add    bx,bx
    add    bx,bx
    lea    si,slope
    add    si,bx

    push    ax
    sub    dx,ax

    mov    ax,dx
    DB LONG; shl    ax,16
    {cdq} DB $66,$99
    DB LONG; idiv    cx
    DB LONG; mov    dx,ax
    DB LONG; shr    dx,16
    mov    xlowadd,ax

    push    dx
    mov    dh,BYTE PTR col1a
    mov    ah,BYTE PTR col1b
    sub    ah,dh
    xor    al,al
    cwd
    idiv    cx
    mov    col1add,ax
    pop    dx
@one:
    pop    cx

    xor    bx,bx
    mov    ah,BYTE PTR col1a    {prepare also colour-slope calc}
    xor    al,al
    mov    di,$8000
@loop:
    cmp    [si],di
    jne    @other
    mov    [si+TYPE(SlopeType)],ah
    mov    [si],cx
    add    si,4
    add    bx,xlowadd
    adc    cx,dx
    add    ax,col1add
    dec    ysize
    jnz    @loop
    jmp    NEAR PTR @zero
@other:
    mov    [si+TYPE(SlopeType)+2],ah
    mov    [si+2],cx
    add    si,4
    add    bx,xlowadd
    adc    cx,dx
    add    ax,col1add
    dec    ysize
    jnz    @loop
@zero:
end;


(*------------------------------------------------*)

procedure CalcAngle;
begin
    sin1:=sinustabel[v1]; cos1:=sinustabel[v1+128];
    sin2:=sinustabel[v2]; cos2:=sinustabel[v2+128];
    sin3:=sinustabel[v3]; cos3:=sinustabel[v3+128];
    v1:=(v1-1) AND 511;
    v2:=(v2+1) AND 511;
    v3:=(v3+2) AND 511;
end;

procedure RotateAllCoords;
var
    i, a,b : integer;
    x,y,z : longint;
    temp : integer;
begin
    a:=0; b:=0;
    for i:=1 to NUMBER_COORDS do begin
        x:=coords[a]; y:=coords[a+1]; z:=coords[a+2];
        inc(a,3);

        temp:=y;
        y:=(LongMul(y,cos1) - LongMul(z,sin1)) DIV 32768;
        z:=(LongMul(temp,sin1) + LongMul(z,cos1)) DIV 32768;
        temp:=x;
        x:=(LongMul(x,cos2) + LongMul(z,sin2)) DIV 32768;
        z:=(LongMul(z,cos2) - LongMul(temp,sin2)) DIV 32768;
        temp:=x;
        x:=(LongMul(x,cos3) - LongMul(y,sin3)) DIV 32768;
        y:=(LongMul(temp,sin3) + LongMul(y,cos3)) DIV 32768;

        cbuffer[b]:=((x SHL 8) DIV (z+800))+160;
        cbuffer[b+1]:=((y SHL 8) DIV (z+800))+100;
        cbuffer[b+2]:=(z-390);
        inc(b,4);
    end;
end;


function FaceShown(i : integer; l1,l2,l3 : byte) : boolean;
var
    a,b : longint;
begin
    a := longmul(cbuffer[l1]-cbuffer[l2],cbuffer[l3+1]-cbuffer[l2+1]);
    b := longmul(cbuffer[l1+1]-cbuffer[l2+1],cbuffer[l3]-cbuffer[l2]);
    FaceShown := (a-b) > 0;
end;


procedure FillShape(y,ysize : integer); assembler;
var
    c1,c2 : byte;
asm
    cmp    ysize,200
    jae    @done
    mov    ax,y
    add    ax,ax
    mov    si,ax
    mov    di,[si+OFFSET ytabel]
    add    di,display1
    lea    si,slope
    add    ax,ax
    add    si,ax

    mov    es,SEGA000
    mov    dx,$3C4
    mov    al,$02
    out    dx,al
    cld
@yloop:
    mov    bh,[si+TYPE(slopetype)] {fetch z value}
    lodsw                                    {fetch first xpos}
    mov    dx,ax
    mov    bl,[si+TYPE(slopetype)] {fetch second z value}
    lodsw                                    {fetch second xpos}
    cmp    ax,dx
    jle    @exchange
    xchg    ax,dx
    xchg    bl,bh
@exchange:
    mov    c1,bl
    mov    c2,bh

    cmp    dx,0
    jl        @filledout_fast
    cmp    ax,320
    jge    @filledout_fast
    cmp    ax,0
    jge    @cut1
    xor    ax,ax
@cut1:
    cmp    dx,319
    jle    @cut2
    mov    dx,319
@cut2:
    push    si
    push    di
    mov    bx,ax
    mov    si,dx
    mov    dx,$3C5

{the next lines are ripped from THE FAKER/S!P shade example}
    mov    al,[bx+OFFSET LineTable1]
    mov    ah,[si+OFFSET LineTable2]
    shr    bx,2
    shr    si,2
    mov    cx,si
    sub    cx,bx
    jcxz    @1
    dec    cx
    add    di,bx
    mov    bh,ah
    out    dx,al
    mov    al,c1
    shr    al,1
    stosb
    jcxz    @4
    mov    al,0Fh
    out    dx,al
    push    bx
    xor    dx,dx
    xor    al,al
    mov    ah,c2
    sub    ah,c1
    sbb    dx,0
    idiv    cx
    mov    si,ax

    mov    dh,c1
    mov    dl,0
    shr    cx,1
    jnc    @2
    add    dx,si
    mov    ax,dx
    shr    ax,9
    stosb
    jcxz    @5

@2:
    add    dx,si
    mov    bx,dx
    shr    bx,1
    add    dx,si
    mov    ax,dx
    shr    ax,1
    mov    al,bh
    stosw
    loop    @2

@5: pop    bx

@4:
    mov al,bh
    mov dx,3c5h
    out dx,al
    mov al,c2
    shr al,1
    stosb
    jmp @3

@1:
    add    di,bx
    and    al,ah
    out    dx,al
    mov    al,c1
    add    al,c2
    rcr    al,1
    shr    al,1
    stosb

@3:

@filledout:
    pop    di
    pop    si
@filledout_fast:
    add    di,WIDTH
    dec    ysize
    jnz    @yloop
@done:
end;


procedure RunOnce;
var
    i : integer;
begin
    SwapDisplay;
    VBLANK;
{$IFDEF DEBUG}
    SetRGB(0,20,0,0);
{$ENDIF}

    ClearScreen(lastscrminy,lastscrmaxy);

    lastscrminy := scrminy; lastscrmaxy := scrmaxy;
    scrminy := 200; scrmaxy := 0;

    CalcAngle;
    RotateAllCoords;

    for i:=1 to NUMBER_FACES do begin
        with face[i] do if FaceShown(i, l1 SHL 2,l2 SHL 2,l3 SHL 2) then begin
            ClearSlope;
            miny := 200; maxy := 0;
            CalcSlope(l1,l2, 2,2);
            CalcSlope(l2,l3, 125,2);
            CalcSlope(l3,l4, 125,125);
            CalcSlope(l4,l1, 2,125);
            FillShape(miny, maxy-miny);
            if (miny < scrminy) then scrminy := miny;
            if (maxy > scrmaxy) then scrmaxy := maxy;
        end;
    end;

{$IFDEF DEBUG}
    SetRGB(0,0,0,0);
    while KeyHit[26] do ; {Hit 'P' to pause}
{$ENDIF}
end;


begin
    OpenScreen;
    InitDemo;
    SetAllInterrupts;
    repeat RunOnce until Key='e';
    RestoreAllInterrupts;
    CloseScreen;
end.